﻿'
' Boogaloo® - http://www.mindfly.com
' Copyright (c) 2008
' by Mindfly, Inc.
'
' Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated 
' documentation files (the "Software"), to deal in the Software without restriction, including without limitation 
' the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and 
' to permit persons to whom the Software is furnished to do so, subject to the following conditions:
'
' The above copyright notice and this permission notice shall be included in all copies or substantial portions 
' of the Software.
'
' THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
' INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
' DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
' SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
' SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
' WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
' THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

Imports System.Web
Imports System.Net
Imports System.Text
Imports System.IO
Imports System.Xml
Imports Boogaloo.Base

Namespace XmlRpc


    Public Class XmlRpcRequest
        Inherits XmlRpcBase

        Public Sub New(ByVal req As HttpContext)
            Setup(ParseRequest(req))
        End Sub

        Public Sub New(ByVal reqXml As String)
            Setup(reqXml)
        End Sub

        Public Sub New()

        End Sub

        Public Delegate Function SendDelegate(ByVal Host As Uri) As XmlRpcResponse

        Public Overloads Function Send(ByVal Host As Uri, ByVal APISend As SendDelegate) As XmlRpcResponse
            Return APISend.Invoke(Host)
        End Function

        Public Overloads Function Send(ByVal Host As Uri) As XmlRpcResponse

            Dim request As HttpWebRequest = WebRequest.Create(Host)
            request.Credentials = CredentialCache.DefaultNetworkCredentials
            request.Method = "POST"
            request.Timeout = 10000
            request.ContentType = "text/xml"

            Using sw As New StreamWriter(request.GetRequestStream, Encoding.ASCII)
                sw.Write(Me.ToXmlString())
            End Using

            Dim response As XmlRpcResponse = Nothing
            Try
                Dim results As String = Nothing
                Using sr As New StreamReader(request.GetResponse.GetResponseStream())
                    results = sr.ReadToEnd().Trim
                End Using
                response = New XmlRpcResponse(results)
            Catch ex As Exception
                ' Stops unhandled exceptions that can cause the app pool to recycle  
                'EventLogger.Write(ex.Message, String.Format("XmlRpcRequest.Send('{0}')", Host.ToString))
            End Try

            
            Return response

        End Function


        ''' <summary>
        ''' Returns the xml construct for the xml-rpc request as a string
        ''' If IncludeTypeElements is False the string is returned without the "type" elements (i4,int,string... etc) to
        ''' conform to certain api ping specs.
        ''' </summary>
        Public Function ToXmlString(Optional ByVal IncludeTypeElements As Boolean = True) As String
            Dim sb As New StringBuilder

            sb.Append("<methodCall>")
            sb.Append(String.Format("<methodName>{0}</methodName>", methodName))
            sb.Append("<params>")

            Dim param As XmlRpcValue = Nothing
            For Each param In params
                sb.Append(String.Format("<param><value>{0}</value></param>", param.ToXmlString(IncludeTypeElements)))
            Next

            sb.Append("</params>")
            sb.Append("</methodCall>")

            Return sb.ToString
        End Function

        Private Sub Setup(ByVal reqXml As String)
            Dim context As HttpContext = HttpContext.Current

            ' validate the rpc call against the schema (xsd)
            Dim settings As New XmlReaderSettings
            Dim path As String = context.Server.MapPath("~/App_Data/xml-rpc.xsd")
            settings.Schemas.Add("", path)
            settings.ValidationType = ValidationType.Schema

            Dim requestDoc As New XmlDocument

            Try
                Dim reader As XmlReader = XmlReader.Create(New StringReader(reqXml), settings)
                requestDoc.Load(reader)

                ' Set the methodName property
                Me.methodName = requestDoc.DocumentElement.SelectSingleNode("methodName").InnerText



                Dim param As XmlNode = Nothing
                For Each param In requestDoc.DocumentElement.SelectNodes("//params/param/value")
                    Me.params.Add(New XmlRpcValue(param.FirstChild))
                Next

            Catch ex As Exception

                'Throw New XmlRpcException("01", String.Format("Invalid XMLRPC Request. ({0})", ex.Message))

            End Try

        End Sub


        ''' <summary>
        ''' Retrieves the content of the input stream
        ''' and return it as plain text.
        ''' </summary>
        ''' <remarks>method from BlogEngine.NET BlogEngine.Core.API.MetaWeblog.XMLRPCRequest</remarks>
        Private Overloads Function ParseRequest(ByVal context As HttpContext) As String
            Dim xml As String = String.Empty
            Using sr As New StreamReader(context.Request.InputStream)
                xml = sr.ReadToEnd
            End Using

            Return SyndicationEncodingUtility.CreateSafeDocument(xml).InnerXml
        End Function


        Private _methodName As String
        Public Property methodName() As String
            Get
                Return _methodName
            End Get
            Set(ByVal value As String)
                _methodName = value
            End Set
        End Property

        Protected _params As New List(Of XmlRpcValue)
        Public Property params() As List(Of XmlRpcValue)
            Get
                Return _params
            End Get
            Set(ByVal value As List(Of XmlRpcValue))
                _params = value
            End Set
        End Property



    End Class


End Namespace